Aim: Plot histogram intensity from imaging experiment
Contact:


Pre-requisites:

1- Specific root folder structure:

The root folder should be named: Intensity_Histogram.
The structure of the root folder should be:
folder structure

2- Installing / Loading required packages:

# Packages names
packages <- c("tidyverse","here","shiny","fs","plotly")

#Install missing packages

installed_packages <- packages %in% rownames(installed.packages())
if (any(installed_packages == FALSE)) {
  installed.packages(packages [!installed_packages])
}

# Packages loading
invisible(lapply(packages, library, character.only = TRUE))

# Delete variables

rm(installed_packages, packages)

# code from: https://statsandr.com/blog/an-efficient-way-to-install-and-load-r-packages/

3- Define the current directory using here package:


here::i_am("Intensity_Histogram.Rproj")
here() starts at C:/Users/bokhobza/OneDrive - Universitaet Bern/Documents/R/Intensity_Histogram

4- Include session information:


xfun::session_info()
R version 4.2.1 (2022-06-23 ucrt)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 22621), RStudio 2022.12.0.353

Locale:
  LC_COLLATE=English_Switzerland.utf8 
  LC_CTYPE=English_Switzerland.utf8   
  LC_MONETARY=English_Switzerland.utf8
  LC_NUMERIC=C                        
  LC_TIME=English_Switzerland.utf8    

Package version:
  askpass_1.1         assertthat_0.2.1    backports_1.4.1    
  base64enc_0.1.3     bit_4.0.5           bit64_4.0.5        
  blob_1.2.3          broom_1.0.2         bslib_0.4.2        
  cachem_1.0.6        callr_3.7.3         cellranger_1.1.0   
  cli_3.6.0           clipr_0.8.0         colorspace_2.1-0   
  commonmark_1.8.1    compiler_4.2.1      cpp11_0.4.3        
  crayon_1.5.2        crosstalk_1.2.0     curl_5.0.0         
  data.table_1.14.6   DBI_1.1.3           dbplyr_2.3.0       
  digest_0.6.31       dplyr_1.0.10        dtplyr_1.2.2       
  ellipsis_0.3.2      evaluate_0.20       fansi_1.0.4        
  farver_2.1.1        fastmap_1.1.0       fontawesome_0.4.0  
  forcats_0.5.2       fs_1.6.0            gargle_1.2.1       
  generics_0.1.3      ggplot2_3.4.0       glue_1.6.2         
  googledrive_2.0.0   googlesheets4_1.0.1 graphics_4.2.1     
  grDevices_4.2.1     grid_4.2.1          gtable_0.3.1       
  haven_2.5.1         here_1.0.1          highr_0.10         
  hms_1.1.2           htmltools_0.5.4     htmlwidgets_1.6.1  
  httpuv_1.6.8        httr_1.4.4          ids_1.0.1          
  isoband_0.2.7       jquerylib_0.1.4     jsonlite_1.8.4     
  knitr_1.41          labeling_0.4.2      later_1.3.0        
  lattice_0.20.45     lazyeval_0.2.2      lifecycle_1.0.3    
  lubridate_1.9.0     magrittr_2.0.3      MASS_7.3.58.2      
  Matrix_1.5.3        memoise_2.0.1       methods_4.2.1      
  mgcv_1.8.41         mime_0.12           modelr_0.1.10      
  munsell_0.5.0       nlme_3.1.161        openssl_2.0.5      
  packrat_0.9.0       pillar_1.8.1        pkgconfig_2.0.3    
  plotly_4.10.1       prettyunits_1.1.1   processx_3.8.0     
  progress_1.2.2      promises_1.2.0.1    ps_1.7.2           
  purrr_1.0.1         R6_2.5.1            rappdirs_0.3.3     
  RColorBrewer_1.1.3  Rcpp_1.0.10         readr_2.1.3        
  readxl_1.4.1        rematch_1.0.1       rematch2_2.1.2     
  reprex_2.0.2        rlang_1.0.6         rmarkdown_2.20     
  rprojroot_2.0.3     rsconnect_0.8.29    rstudioapi_0.14    
  rvest_1.0.3         sass_0.4.4          scales_1.2.1       
  selectr_0.4.2       shiny_1.7.4         sourcetools_0.1.7  
  splines_4.2.1       stats_4.2.1         stringi_1.7.12     
  stringr_1.5.0       sys_3.4.1           tibble_3.1.8       
  tidyr_1.2.1         tidyselect_1.2.0    tidyverse_1.3.2    
  timechange_0.2.0    tinytex_0.43        tools_4.2.1        
  tzdb_0.3.0          utf8_1.2.2          utils_4.2.1        
  uuid_1.1.0          vctrs_0.5.2         viridisLite_0.4.1  
  vroom_1.6.1         withr_2.5.0         xfun_0.36          
  xml2_1.3.3          xtable_1.8-4        yaml_2.3.6         

Plot


data_path <- paste(here("data", "raw_data"), list.files(here("data", "raw_data")), sep = "/")

df_input <- map(data_path, readxl::read_excel)

names(df_input) <- str_replace(list.files(here("data", "raw_data")), pattern = ".xlsx", replacement = "")

df <- bind_rows(df_input, .id = 'id')

# Cleaning
rm(data_path, df_input)

p <- ggplot(df, aes(x=Value, fill=id)) + geom_histogram(binwidth = 5, alpha=.5)

p

Interactive plot


ggplotly(p)
NA

Save the plot


  ggsave(filename = here("output", "histogram.png"))
LS0tDQp0aXRsZTogIkludGVuc2l0eV9oaXN0b2dyYW0iDQphdXRob3I6ICJBIEJva2hvYnphIg0KZGF0ZTogIjIwMjMtMDEtMjQiDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQoqKkFpbSoqOiBQbG90IGhpc3RvZ3JhbSBpbnRlbnNpdHkgZnJvbSBpbWFnaW5nIGV4cGVyaW1lbnRcDQoqKkNvbnRhY3QqKjogW2FsZXhhbmRyZS5ib2tob2J6YVxAZ21haWwuY29tXShtYWlsdG86YWxleGFuZHJlLmJva2hvYnphQGdtYWlsLmNvbSl7LmVtYWlsfVwNCg0KLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tDQoNCiMjIFByZS1yZXF1aXNpdGVzOg0KDQoxLSBTcGVjaWZpYyByb290IGZvbGRlciBzdHJ1Y3R1cmU6DQoNClRoZSByb290IGZvbGRlciBzaG91bGQgYmUgbmFtZWQ6IEludGVuc2l0eV9IaXN0b2dyYW0uXA0KVGhlIHN0cnVjdHVyZSBvZiB0aGUgcm9vdCBmb2xkZXIgc2hvdWxkIGJlOlwNCiFbZm9sZGVyIHN0cnVjdHVyZV0ocm9vdF9mb2xkZXJfc3RydWN0LnBuZylcDQoNCjItIEluc3RhbGxpbmcgLyBMb2FkaW5nIHJlcXVpcmVkIHBhY2thZ2VzOg0KDQpgYGB7ciwgbWVzc2FnZT1GQUxTRX0NCiMgUGFja2FnZXMgbmFtZXMNCnBhY2thZ2VzIDwtIGMoInRpZHl2ZXJzZSIsImhlcmUiLCJzaGlueSIsImZzIiwicGxvdGx5IikNCg0KI0luc3RhbGwgbWlzc2luZyBwYWNrYWdlcw0KDQppbnN0YWxsZWRfcGFja2FnZXMgPC0gcGFja2FnZXMgJWluJSByb3duYW1lcyhpbnN0YWxsZWQucGFja2FnZXMoKSkNCmlmIChhbnkoaW5zdGFsbGVkX3BhY2thZ2VzID09IEZBTFNFKSkgew0KICBpbnN0YWxsZWQucGFja2FnZXMocGFja2FnZXMgWyFpbnN0YWxsZWRfcGFja2FnZXNdKQ0KfQ0KDQojIFBhY2thZ2VzIGxvYWRpbmcNCmludmlzaWJsZShsYXBwbHkocGFja2FnZXMsIGxpYnJhcnksIGNoYXJhY3Rlci5vbmx5ID0gVFJVRSkpDQoNCiMgRGVsZXRlIHZhcmlhYmxlcw0KDQpybShpbnN0YWxsZWRfcGFja2FnZXMsIHBhY2thZ2VzKQ0KDQojIGNvZGUgZnJvbTogaHR0cHM6Ly9zdGF0c2FuZHIuY29tL2Jsb2cvYW4tZWZmaWNpZW50LXdheS10by1pbnN0YWxsLWFuZC1sb2FkLXItcGFja2FnZXMvDQoNCmBgYA0KDQozLSBEZWZpbmUgdGhlIGN1cnJlbnQgZGlyZWN0b3J5IHVzaW5nIGhlcmUgcGFja2FnZToNCg0KYGBge3J9DQoNCmhlcmU6OmlfYW0oIkludGVuc2l0eV9IaXN0b2dyYW0uUnByb2oiKQ0KDQoNCmBgYA0KDQo0LSBJbmNsdWRlIHNlc3Npb24gaW5mb3JtYXRpb246DQoNCmBgYHtyLCBtZXNzYWdlPUZBTFNFfQ0KDQp4ZnVuOjpzZXNzaW9uX2luZm8oKQ0KDQpgYGANCg0KIyMgUGxvdA0KDQo8IS0tIFJlYWQgdGhlIGRhdGEgLS0+DQoNCmBgYHtyLCBtZXNzYWdlPUZBTFNFfQ0KDQpkYXRhX3BhdGggPC0gcGFzdGUoaGVyZSgiZGF0YSIsICJyYXdfZGF0YSIpLCBsaXN0LmZpbGVzKGhlcmUoImRhdGEiLCAicmF3X2RhdGEiKSksIHNlcCA9ICIvIikNCg0KZGZfaW5wdXQgPC0gbWFwKGRhdGFfcGF0aCwgcmVhZHhsOjpyZWFkX2V4Y2VsKQ0KDQpuYW1lcyhkZl9pbnB1dCkgPC0gc3RyX3JlcGxhY2UobGlzdC5maWxlcyhoZXJlKCJkYXRhIiwgInJhd19kYXRhIikpLCBwYXR0ZXJuID0gIi54bHN4IiwgcmVwbGFjZW1lbnQgPSAiIikNCg0KZGYgPC0gYmluZF9yb3dzKGRmX2lucHV0LCAuaWQgPSAnaWQnKQ0KDQojIENsZWFuaW5nDQpybShkYXRhX3BhdGgsIGRmX2lucHV0KQ0KDQpgYGANCg0KPCEtLSBHZW5lcmF0ZSBoaXN0b2dyYW0gLS0+DQoNCmBgYHtyfQ0KDQpwIDwtIGdncGxvdChkZiwgYWVzKHg9VmFsdWUsIGZpbGw9aWQpKSArIGdlb21faGlzdG9ncmFtKGJpbndpZHRoID0gNSwgYWxwaGE9LjUpDQoNCnANCg0KYGBgDQoNCiMjIEludGVyYWN0aXZlIHBsb3QNCg0KYGBge3J9DQoNCmdncGxvdGx5KHApDQoNCmBgYA0KDQoNCiMjIFNhdmUgdGhlIHBsb3QNCg0KYGBge3J9DQoNCiAgZ2dzYXZlKGZpbGVuYW1lID0gaGVyZSgib3V0cHV0IiwgImhpc3RvZ3JhbS5wbmciKSkNCg0KDQpgYGANCg0K